(ns win.flash-ax
  (:use jna
        jna.win.user32
        jna.win.ole32
        jna.win.oleacc
        jna.win.guid
        jna.win.mshtml
        [win.gui-test :only [SendKeys]]
        win.com ; you don't have to call CoInitialize if use win.com
        util.utils
        xml.dom))

;;; find flash

(def default-IHTMLDocument-type IID_IHTMLDocument6)

(defn- IHTMLDocument
  ([ie doc-type]
    (let [message (RegisterWindowMessage "WM_HTML_GETOBJECT")
          result (SendMessageTimeout ie message 0 0 SMTO_ABORTIFHUNG 1000)
          dispatch (raw-dispatch (ObjectFromLresult result doc-type 0))]
      dispatch))
  ([ie]
    (IHTMLDocument ie default-IHTMLDocument-type)))

(defn- is-wanted-ie? [{doc :doc} titlep urlp]
  (let [title (dispatch-get doc title)
        url (dispatch-get doc URL)]
    (some (fn [[p v]] (and p (re-find (re p) v))) [[titlep title] [urlp url]])))

(defn find-ie ; TODO: probably should not be a part of win.flash-ax
  ([title url]
    (let [ies (FindTopWindowLike #"(Microsoft|Windows) Internet Explorer" "IEFrame")
          tabs (flatten (map (fn [top] (map (fn [tab] {:top top :tab tab}) (FindWindowLike top nil "Internet Explorer_Server"))) ies))
          docs (map (fn [{tab :tab :as x}] (assoc x :doc (IHTMLDocument tab))) tabs)]
      (filter #(is-wanted-ie? % title url) docs)))
  ([title]
    (find-ie title nil)))

(defn find-flash [{ie :doc :as x} id]
  (dispatch-call ie getElementById [id]))

(defn switch-tab [{top :top tab :tab}] ; TODO: probably should not be a part of win.flash-ax
  ; FIXME: looks like bad code, too long...
  (let [tabs (FindWindowLike top nil "TabWindowClass")
        tab (GetParent (GetParent tab))]
    (when-not (= (GetClassName tab) "TabWindowClass")
      (throw (Exception. "No proper TabWindowClass found in IE. Is it a supported IE version?")))
    (when-not (seq (filter #(= % tab) tabs))
      (throw (Exception. "Tab is not a correct tab under top?")))
    (let [tab-title (GetWindowText tab)
          n (count tabs)]
      (loop [i 0]
        (when (<= n i)
          (throw (Exception. "No tab title matches window tab, unbelievable!")))
        (when-not (= (GetWindowText top) tab-title)
          (SendKeys "^{TAB}")
          (sleep-milliseconds 100) ; sleep 1 seconds
          (recur (inc i)))))))

;;; call flash

(defn flash-version [flash]
  (dispatch-call flash GetVariable ["$version"]))

(declare encode-flash-arguments)
(declare decode-flash-value)

(defn flash-raw-call [flash arguments-xml]
  (dispatch-call flash CallFunction [arguments-xml]))

(defn flash-call [flash name & args]
  (decode-flash-value (flash-raw-call flash (encode-flash-arguments name args))))

(defn flash-fn [flash name]
  (let [CallFunction (dispatch-fn flash CallFunction)]
    (fn [& args]
      (decode-flash-value (CallFunction (encode-flash-arguments name args))))))


;;; CallFunction encoder/decoder

(defmulti insert-flash-value (fn [doc node v] (class v)))

(defmethod insert-flash-value String [doc node v]
  (append-text doc node "string" v))

(defmethod insert-flash-value Number [doc node v]
  (append-text doc node "number" (str v)))

(defmethod insert-flash-value :default [doc node v]
  (throw (Exception. (str "Don't know how to encode " (prn-str v)))))

(defn- encode-flash-arguments [name args]
  (let [xml (format "<invoke name=\"%s\" returntype=\"xml\"/>" name)]
    (if (empty? args)
      xml
      (let [doc (xml->doc xml)
            argsnode (append-child doc (get-child-node doc "invoke") "arguments")]
        (doseq [arg args]
          (insert-flash-value doc argsnode arg))
        (remove-prolog (doc->xml doc))))))

(defmulti read-flash-value get-tag)

(defmethod read-flash-value "string" [node]
  (get-text node))

(defmethod read-flash-value "number" [node]
  (let [exp (get-text node)]
    (if (= (.indexOf exp (int \.)) -1)
      (Integer/parseInt exp)
      (Double/parseDouble exp))))

(defmethod read-flash-value "null" [node]
  nil)

(defmethod read-flash-value "undefined" [node]
  nil)

(defmethod read-flash-value "true" [node]
  true)

(defmethod read-flash-value "false" [node]
  false)

(defmethod read-flash-value "array" [node]
  (loop [v []
         nodes (get-children node)]
    (if (seq nodes)
      (recur (conj v (read-flash-value (get-first-child (first nodes)))) (rest nodes))
      v)))

(defmethod read-flash-value "object" [node]
  (loop [v {}
         nodes (get-children node)]
    (if (seq nodes)
      (recur (assoc v (get-attribute (first nodes) "id") (read-flash-value (get-first-child (first nodes)))) (rest nodes))
      v)))

(defmethod read-flash-value :default [node]
  (throw (Exception. (str "Don't know how to decode " (remove-prolog (doc->xml node))))))

(defn- decode-flash-value [xml]
  (let [doc (xml->doc xml)]
    (read-flash-value (get-root-node doc))))

;;; test

;(println (encode-flash-arguments "x" [1 2 "Hello"]))

;(let [flash (find-flash (as-one (find-ie "M3O")) "Main")
;      CallFunction (flash-bind)]
;  CallFunction)

;(let [flash (find-flash (as-one (find-ie nil "TestFlash")) "TestFlashBuilder4")
;      f (flash-fn flash "getArray")]
;  (prn (flash-call flash "getArray" "" 0))
;  (prn (f "hello" 7)))

